home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / dialogInternal.icl < prev    next >
Encoding:
Modula Implementation  |  1997-04-23  |  26.2 KB  |  735 lines  |  [TEXT/3PRM]
  1. implementation module dialogInternal;
  2.  
  3. import StdClass,StdInt, StdMisc, StdString, StdBool, StdChar,StdArray;
  4. import    menus, windows, dialogs, structure, memory, controls, quickdraw;
  5. import    Picture, dialogDef, ioState, windowDevice;
  6. from    menuInternal import CheckItemTitle;
  7.  
  8. ModelessDialogType     :== 4;    //    The window type must be NoGrowDocProc    = 4
  9. ModalDialogType        :== 1;    //    The window type must be dBoxProc        = 1
  10. EmptyDialogPtr        :== -1;
  11. PopUpMenuID            :== 235;
  12.  
  13.  
  14. ::    NoticeRep *s :== (!NoticeHandle s (IOState s), !DialogPtr);
  15. ::    Response  *s
  16.     =     Final        (ButtonFunction s (IOState s))
  17.     |     RadioBox    (DialogFunction s (IOState s))
  18.     |     Void_new;
  19.  
  20.  
  21. DialogInternalError :: String String -> .x;
  22. DialogInternalError f error = Error f "dialogInternal" error;
  23.  
  24.  
  25. //    Functions on DialogDef's and ItemLists.
  26.  
  27. GetDialogDefId :: !(DialogDef s io) -> DialogId;
  28. GetDialogDefId (PropertyDialog id _ _ _ _ _) = id;
  29. GetDialogDefId (CommandDialog  id _ _ _ _  ) = id;
  30.  
  31.  
  32. //    Get a PopUpHandle from a list of PopUpHandles.
  33.  
  34. GetPopUpHandle :: !DialogItemId ![PopUpHandle] -> PopUpHandle;
  35. GetPopUpHandle pid [handle=:(id,m) : rest]
  36. |    pid == id    = handle;
  37.                 = GetPopUpHandle pid rest;
  38. GetPopUpHandle pid []
  39.     =    DialogInternalError "GetPopUpHandle" ("Unknown item id: " +++ toString pid);
  40.  
  41.  
  42. //    OpenAnyDialog opens a dialog.
  43.  
  44. OpenAnyDialog :: !DialogMode !DialogPtr !(DialogDef s (IOState s)) !Toolbox
  45.     ->    (!DialogRep s (IOState s), !Toolbox);
  46. OpenAnyDialog mode ptr dDef tb
  47.     =    (dRep1, HiliteDialogItems dRep1 tb1);
  48.     where {
  49.         (dRep1,tb1) = CreateDialog ptr (DialogDefToDialogHandle mode dDef, EmptyDialogPtr) tb;
  50.     };
  51.  
  52.  
  53. //    DoNotice opens and handles the notice specified by the NoticeDef argument.
  54.  
  55. DoNotice :: !NoticeDef !(IOState s) -> (!NoticeButtonId, !IOState s);
  56. DoNotice nDef ioState
  57.     =    DeactivateNotice (HandleNoticeEvents nRep tb1) outlineF ioState3;
  58.     where {
  59.         (cShape,ioState1)    = IOStateGetGlobalCursor ioState;
  60.         ioState2            = IOStateSetCursorShape cShape ioState1;
  61.         (tb,    ioState3)    = IOStateGetToolbox ioState2;
  62.         (nRep,outlineF,tb1)    = CreateNotice (NoticeDefToNoticeHandle nDef,EmptyDialogPtr) tb;
  63.     };
  64.  
  65.  
  66. /*    HandleDialogEvent handles an event for a modal or a modeless dialog:
  67.     Given the number of the clicked item it shows the effect of the click and
  68.     returns the appropriate Response. */
  69.  
  70. HandleDialogEvent :: !(DialogHandle s (IOState s)) !DialogPtr !Toolbox !Int
  71.     ->    (!DialogRep s (IOState s), !Response s, !Toolbox);
  72. HandleDialogEvent (DialogH id tt md rc ps items rs) ptr tb itemNr
  73.     =    ((DialogH id tt md rc ps items1 rs, ptr), resp, tb1);
  74.     where {
  75.         (items1, resp, tb1) = HandleDialogItemEvent items ptr tb 1 itemNr;
  76.     };
  77.  
  78. HandleDialogItemEvent :: ![DialogItem s (IOState s)] !DialogPtr !Toolbox !Int !Int
  79.     ->    (![DialogItem s (IOState s)], !Response s, !Toolbox);
  80. HandleDialogItemEvent items=:[button=:DialogButton id ps tt ss butfunc : rest] ptr tb i itemnr
  81. |    i == itemnr    = (items, Final butfunc, tb);
  82.                 = ([button : rest`], resp, tb1);
  83.     where {
  84.         (rest`, resp, tb1) = HandleDialogItemEvent rest ptr tb (inc i) itemnr;
  85.     };
  86. HandleDialogItemEvent [CheckBoxes id p r boxes : rest] ptr tb i itemnr
  87.     =    ([CheckBoxes id p r boxes` : rest`], resp, tb1);
  88.     where {
  89.         (boxes`, rest`, resp, tb1) = HandleCheckBoxEvent boxes rest ptr tb i itemnr;
  90.     };
  91. HandleDialogItemEvent [buts=:RadioButtons id p r pid buttons : rest] ptr tb i itemnr
  92. |    itemnr >= iplusnrb    = ([buts : rest`], resp1, tb1);
  93.                         = ([RadioButtons id p r pid` buttons : rest], resp2, tb2);
  94.     where {
  95.         (rest`,resp1,tb1)    = HandleDialogItemEvent         rest     ptr tb iplusnrb itemnr;
  96.         (pid` ,resp2,tb2)    = HandleRadioButtonEvent pid buttons ptr tb i         itemnr;
  97.         iplusnrb            = i + Length_new buttons;
  98.     };
  99. HandleDialogItemEvent [item=:DialogPopUp id ps ab di bs : rest] ptr tb i itemnr
  100.     =    ([item : rest`], resp, tb1);
  101.     where {
  102.         (rest`, resp, tb1) = HandleDialogItemEvent rest ptr tb i itemnr;
  103.     };
  104. HandleDialogItemEvent [item=:DialogIconButton id ps pd il ab bf : rest] ptr tb i itemnr
  105.     =    ([item : rest`], resp, tb1);
  106.     where {
  107.         (rest`, resp, tb1) = HandleDialogItemEvent rest ptr tb i itemnr;
  108.     };
  109. HandleDialogItemEvent [item=:Control id ps pd ab cs cl cf df : rest]  ptr tb i itemnr
  110.     =    ([item : rest`], resp, tb1);
  111.     where {
  112.         (rest`, resp, tb1) = HandleDialogItemEvent rest ptr tb i itemnr;
  113.     };
  114. HandleDialogItemEvent [item : rest] ptr tb i itemnr
  115.     =    ([item : rest`], resp, tb1);
  116.     where {
  117.         (rest`, resp, tb1) = HandleDialogItemEvent rest ptr tb (inc i) itemnr;
  118.     };
  119. HandleDialogItemEvent rest _ tb _ _ = (rest,Void_new, tb);
  120.  
  121. HandleCheckBoxEvent :: ![CheckBoxDef s (IOState s)] ![DialogItem s (IOState s)] !DialogPtr !Toolbox !Int !Int
  122.     ->    (![CheckBoxDef s (IOState s)], ![DialogItem s (IOState s)], !Response s, !Toolbox);
  123. HandleCheckBoxEvent [box=:CheckBox id tt ss mark dfunc : rest] items ptr tb i itemnr
  124. |    thisitem && Checked mark    = ([box1 : rest ], items,  RadioBox dfunc, SetCtlValue h 0 tb1);
  125. |    thisitem                    = ([box1 : rest ], items,  RadioBox dfunc, SetCtlValue h 1 tb1);
  126.                                 = ([box  : rest`], items`, resp, tb`);
  127.     where {
  128.         thisitem                = i == itemnr;
  129.         box1                    = CheckBox id tt ss (MarkSwitch mark) dfunc;
  130.         (it,h,rect,tb1)            = GetDItem ptr i tb;
  131.         (rest`,items`,resp,tb`)    = HandleCheckBoxEvent rest items ptr tb (inc i) itemnr;
  132.     };
  133. HandleCheckBoxEvent rest items ptr tb i itemnr
  134.     =    (rest, items`, resp, tb`);
  135.     where {
  136.         (items`, resp, tb`) = HandleDialogItemEvent items ptr tb i itemnr;
  137.     };
  138.  
  139. HandleRadioButtonEvent :: !Int ![RadioItemDef s (IOState s)] !DialogPtr !Toolbox !Int !Int
  140.     -> (!Int, !Response s, !Toolbox);
  141. HandleRadioButtonEvent pid [but=:RadioItem id tt ss dfunc : rest] ptr tb i itemnr
  142. |    found && idmatch    = (id, Void_new,        tb);
  143. |    found                = (id, RadioBox dfunc,    SetCtlValue h  1 tb2 );
  144. |    idmatch                = (id`,resp,            SetCtlValue h` 0 tb``);
  145.                         = (id`,resp,            tb`);
  146.     where {
  147.         tb1                = UnpressRadioButton pid rest ptr tb (inc i);
  148.         (_,h,_,tb2)        = GetDItem ptr i tb1;
  149.         (id`,resp,tb`)    = HandleRadioButtonEvent pid rest ptr tb (inc i) itemnr;
  150.         (_,h`,_,tb``)    = GetDItem ptr i tb`;
  151.         found            = i  == itemnr;
  152.         idmatch            = id == pid;
  153.     };
  154. HandleRadioButtonEvent _ _ _ _ _ _
  155.     =    DialogInternalError "HandleRadioButtonEvent" "Event is no radio button event";
  156.  
  157. /*    UnpressRadioButton unpresses the radio button with the indicated id. The fourth parameter
  158.     is the item number of the first radio button in the list. */
  159.  
  160. UnpressRadioButton    :: !DialogItemId ![RadioItemDef s (IOState s)] !DialogPtr !Toolbox !Int -> Toolbox;
  161. UnpressRadioButton pid [RadioItem id tt ss df : rest] ptr tb i
  162. |    id == pid    = SetCtlValue h 0 tb1;
  163.                 = UnpressRadioButton pid rest ptr tb (inc i);
  164.     where {
  165.         (it,h,rect,tb1)    = GetDItem ptr i tb;
  166.     };
  167. UnpressRadioButton _ _ _ tb _ = tb;
  168.  
  169.  
  170. //    Notice event handling.
  171.  
  172. HandleNoticeEvents :: !(NoticeRep s) !Toolbox -> (!NoticeButtonId, !NoticeRep s, !Toolbox);
  173. HandleNoticeEvents nRep=:(_,ptr) tb
  174.     =    HandleNoticeEvent nRep itemNr tb1;
  175.     where {
  176.         (itemNr, tb1) = ModalDialog 0 ptr tb;
  177.     };
  178.  
  179. HandleNoticeEvent :: !(NoticeRep s) !Int !Toolbox -> (!NoticeButtonId, !NoticeRep s, !Toolbox);
  180. HandleNoticeEvent nRep=:(notice,_) nr tb
  181. |    nr > 0    = (FindNoticeButtonId nr notice, nRep, tb);
  182.             = HandleNoticeEvents nRep tb;
  183.  
  184. FindNoticeButtonId :: !Int !(NoticeHandle s (IOState s)) -> NoticeButtonId;
  185. FindNoticeButtonId nr (NoticeH _ items) = FindButtonIdInItemList nr items;
  186.  
  187. FindButtonIdInItemList :: !Int ![DialogItem s (IOState s)] -> NoticeButtonId;
  188. FindButtonIdInItemList 1 [DialogButton id _ _ _ _ : _]    = id;
  189. FindButtonIdInItemList 1 _                                = -1;
  190. FindButtonIdInItemList n [_ : items]                    = FindButtonIdInItemList (dec n) items;
  191.  
  192.  
  193. //    Create and activate a dialog.
  194.  
  195. CreateDialog :: !DialogPtr !(DialogRep s (IOState s)) !Toolbox -> (!DialogRep s (IOState s), !Toolbox);
  196. CreateDialog ptr (dH=:DialogH id tt md rc ps items rs, EmptyDialogPtr) tb
  197.     =    ((DialogH id tt md rc popUpHs items rs, dPtr), tb2);
  198.     where {
  199.         (dPtr,   tb1) = MakeDialog ptr dH tb;
  200.         (popUpHs,tb2) = CreatePopUpHandles DialogFont items tb1;
  201.     };
  202. CreateDialog _ _ _
  203.     =    DialogInternalError "CreateDialog" "Cannot create the same dialog twice";
  204.  
  205. CreatePopUpHandles :: !Font ![DialogItem s (IOState s)] !Toolbox -> (![PopUpHandle], !Toolbox);
  206. CreatePopUpHandles dfont [DialogPopUp id (ItemBox l t w h) ab di buts : rest] tb
  207.     =    ([(id,menuH) : popUpHs], tb3);
  208.     where {
  209.         (menuH,tb1)        = NewMenu PopUpMenuID "" tb;
  210.         tb2                = AppendPopUpButtons di buts 1 menuH tb1;
  211.         (popUpHs, tb3)    = CreatePopUpHandles dfont rest tb2;
  212.     };
  213. CreatePopUpHandles dfont [_ : rest] tb = CreatePopUpHandles dfont rest tb;
  214. CreatePopUpHandles _ _ tb = ([],tb);
  215.  
  216. AppendPopUpButtons :: !DialogItemId ![RadioItemDef s (IOState s)] !Int !MacMenuHandle !Toolbox -> Toolbox;
  217. AppendPopUpButtons pid [RadioItem id title abty df : rest] itemnr menuH tb
  218.     =    AppendPopUpButtons pid rest (inc itemnr) menuH tb2;
  219.     where {
  220.         tb1    = AppendMenu menuH (MacMetaChars (pid == id) abty) tb;
  221.         tb2    = SetItem menuH itemnr (CheckItemTitle title) tb1;
  222.  
  223.     };
  224. AppendPopUpButtons _ _ _ _ tb = tb;
  225.  
  226. MacMetaChars :: !Bool !SelectState -> String;
  227. MacMetaChars mark abty
  228. |    mark && able    = title +++ check;
  229. |    mark            = title +++ disable +++ check;
  230. |    able            = title;
  231.                     = title +++ disable;
  232.     where {
  233.         able    = Enabled abty;
  234.         title    = " ";
  235.         disable    = "(";
  236.         check    = "!" +++ toString (toChar 18);
  237.     };
  238.  
  239. MakeDialog :: !DialogPtr !(DialogHandle s (IOState s)) !Toolbox -> (!DialogPtr, !Toolbox);
  240. MakeDialog behind (DialogH id title Modal rect popups items rest) tb
  241. |    hasColor    = NewCDialog 0 rect title True ModalDialogType behind False 0 items1 tb2;
  242.                 = NewDialog  0 rect title True ModalDialogType behind False 0 items1 tb2;
  243.     where {
  244.         (hasColor, tb1) = HasColorQD tb;
  245.         (items1,   tb2) = CreateDialogItems items tb1;
  246.     };
  247. MakeDialog behind (DialogH id title modeless rect popups items rest) tb
  248. |    hasColor    = NewCDialog 0 rect title True ModelessDialogType behind True 0 items1 tb2;
  249.                 = NewDialog  0 rect title True ModelessDialogType behind True 0 items1 tb2;
  250.     where {
  251.         (hasColor, tb1) = HasColorQD tb;
  252.         (items1,   tb2) = CreateDialogItems items tb1;
  253.     };
  254.  
  255.  
  256. //    Create and activate a notice.
  257.  
  258. CreateNotice :: !(NoticeRep s) !Toolbox -> (!NoticeRep s, !ProcPtr, !Toolbox);
  259. CreateNotice (notice=:(NoticeH rect items),EmptyDialogPtr) tb
  260.     =    ((notice, nPtr), outlineF, tb2);
  261.     where {
  262.         (items1,outlineF,tb1)    = CreateNoticeItems items tb;
  263.         (nPtr,  tb2)            = NewDialog 0 rect "" True ModalDialogType (-1) False 0 items1 tb1;
  264.     };
  265. CreateNotice _ _
  266.     =    DialogInternalError "CreateNotice" "Cannot activate the same notice twice";
  267.  
  268.  
  269. //    Activate/Deactivate and dispose a dialog.
  270.  
  271. ActivateDialog :: !(DialogHandles s) !Toolbox -> Toolbox;
  272. ActivateDialog [(_,ptr) :_] tb = SelectWindow ptr tb;
  273.  
  274. DeactivateDialog :: !(DialogRep s (IOState s)) !(IOState s) -> IOState s;
  275. DeactivateDialog (DialogH _ _ _ _ popUpHs _ _, ptr) ioState
  276.     =    IOStateSetToolbox (DisposDialog ptr (DisposePopUpMenus popUpHs tb)) ioState1;
  277.     where {
  278.         (tb, ioState1) = IOStateGetToolbox ioState;
  279.     };
  280.  
  281. DisposePopUpMenus :: ![PopUpHandle] !Toolbox -> !Toolbox;
  282. DisposePopUpMenus [(_,menuH) : rest] tb = DisposePopUpMenus rest (DisposeMenu menuH tb);
  283. DisposePopUpMenus _ tb = tb;
  284.  
  285.  
  286. //    Deactivate and dispose a notice.
  287.  
  288. DeactivateNotice :: !(!NoticeButtonId, !NoticeRep s, !Toolbox) !ProcPtr !(IOState s)
  289.     ->    (!NoticeButtonId, !IOState s);
  290. DeactivateNotice (id,(_,ptr),tb) outlineF ioState
  291.     =    (id, IOStateSetToolbox (DisposDialog ptr (DisposeRoutineDescriptor outlineF tb)) ioState);
  292.  
  293.  
  294. /*    After the creation and filling of the dialog the inactive items must be hilited,
  295.     the marked check boxes must be marked and the pressed radio button must be pressed. */
  296.  
  297. HiliteDialogItems :: !(DialogRep s (IOState s)) !Toolbox -> Toolbox;
  298. HiliteDialogItems (DialogH _ _ _ _ _ items _, ptr) tb = HiliteItems True ptr items tb 1;
  299.  
  300. HiliteItems    :: !Bool !DialogPtr ![DialogItem s (IOState s)] !Toolbox !Int -> Toolbox;
  301. HiliteItems b ptr [CheckBoxes id ps rc boxes : items] tb nr
  302.     =    HiliteCheckBoxes ptr boxes items b tb nr;
  303. HiliteItems b ptr [RadioButtons id ps rc pid buttons : items] tb nr
  304.     =    HiliteRadioButtons ptr buttons items b pid tb nr;
  305. HiliteItems b ptr [DialogButton id t s ability bf : items] tb nr
  306. |    Enabled ability = tb1;
  307.                     = Hilite ptr nr tb1;
  308.     where {
  309.         tb1 = HiliteItems b ptr items tb (inc nr);
  310.     };
  311. HiliteItems notyet ptr [EditText id ps wd nl txt : items] tb nr
  312. |    notyet && txt <> ""    = SelIText ptr nr 0 32767 tb1;
  313.                             = tb1;
  314.     where {
  315.         tb1 = HiliteItems False ptr items tb (inc nr);
  316.     };
  317. HiliteItems b ptr [DialogPopUp id ps ab di bs : items] tb nr
  318.     =    HiliteItems b ptr items tb nr;
  319. HiliteItems b ptr [DialogIconButton id ps pd il ab bf : items] tb nr
  320.     =    HiliteItems b ptr items tb nr;
  321. HiliteItems b ptr [Control id ps pd ab cs cl cf df : items] tb nr
  322.     =    HiliteItems b ptr items tb nr;
  323. HiliteItems b ptr [_ : items] tb nr
  324.     =    HiliteItems b ptr items tb (inc nr);
  325. HiliteItems _ _ _ tb _ = tb;
  326.  
  327. HiliteRadioButtons :: !DialogPtr ![RadioItemDef s (IOState s)] ![DialogItem s (IOState s)]
  328.         !Bool !DialogId !Toolbox !Int -> Toolbox;
  329. HiliteRadioButtons ptr [RadioItem id tt Able df : buttons] items b pid tb nr
  330. |    id == pid    = SetCtlValue h 1 tb2;
  331.                 = tb1;
  332.     where {
  333.         tb1            = HiliteRadioButtons ptr buttons items b pid tb (inc nr);
  334.         (_,h,_,tb2)    = GetDItem ptr nr tb1;
  335.     };
  336. HiliteRadioButtons ptr [RadioItem id tt unable df : buttons] items b pid tb nr
  337. |    id == pid    = HiliteControl h 255 (SetCtlValue h 1 tb2);
  338.                 = Hilite ptr nr tb1;
  339.     where {
  340.         tb1            = HiliteRadioButtons ptr buttons items b pid tb (inc nr);
  341.         (_,h,_,tb2)    = GetDItem ptr nr tb1;
  342.     };
  343. HiliteRadioButtons ptr _ items b _ tb nr = HiliteItems b ptr items tb nr;
  344.  
  345. HiliteCheckBoxes :: !DialogPtr ![CheckBoxDef s (IOState s)] ![DialogItem s (IOState s)]
  346.         !Bool !Toolbox !Int -> Toolbox;
  347. HiliteCheckBoxes ptr [CheckBox id tt Able mark df : boxes] items b tb nr
  348. |    Checked mark    = SetCtlValue h 1 tb2;
  349.                     = tb1;
  350.     where {
  351.         tb1            = HiliteCheckBoxes ptr boxes items b tb (inc nr);
  352.         (_,h,_,tb2)    = GetDItem ptr nr tb1;
  353.     };
  354. HiliteCheckBoxes ptr [CheckBox id tt unable mark df : boxes] items b tb nr
  355. |    Checked mark    = HiliteControl h 255 (SetCtlValue h 1 tb2);
  356.                     = Hilite ptr nr tb1;
  357.     where {
  358.         tb1            = HiliteCheckBoxes ptr boxes items b tb (inc nr);
  359.         (_,h,_,tb2)    = GetDItem ptr nr tb1;
  360.     };
  361. HiliteCheckBoxes ptr _ items b tb nr = HiliteItems b ptr items tb nr;
  362.  
  363. Hilite :: !DialogPtr !Int !Toolbox -> Toolbox;
  364. Hilite dPtr itemNr tb
  365.     =    HiliteControl h 255 tb1;
  366.     where {
  367.         (_,h,_,tb1) = GetDItem dPtr itemNr tb;
  368.     };
  369.  
  370. Unhilite :: !DialogPtr !Int !Toolbox -> Toolbox;
  371. Unhilite dPtr itemNr tb
  372.     =    HiliteControl h 0 tb1;
  373.     where {
  374.         (_,h,_,tb1) = GetDItem dPtr itemNr tb;
  375.     };
  376.  
  377.  
  378. //    Draw a DialogPopUp, an IconButton or a Control in a dialog.
  379.  
  380. DrawDefButtonOutline :: !ItemPos !DialogPtr !Toolbox -> Toolbox;
  381. DrawDefButtonOutline (ItemBox l t w h) dPtr tb
  382.     =    tb6;
  383.     where {
  384.         (port, tb1)    = QGetPort tb;
  385.         tb2            = QSetPort dPtr tb1;
  386.         tb3            = QPenSize 3 3 tb2;
  387.         tb4            = QFrameRoundRect rect 16 16 tb3;
  388.         tb5            = QPenSize 1 1 tb4;
  389.         tb6            = QSetPort port tb5;
  390.         rect        = (l - 4,t - 4, l + w  + 4, t + h  + 4);
  391.     };
  392.  
  393. RedrawPopUp :: !ItemPos !SelectState !String !DialogPtr !Toolbox -> Toolbox;
  394. RedrawPopUp (ItemBox l t w h) select item dPtr tb
  395.     =    tb5;
  396.     where {
  397.         (port, tb1)    = QGetPort tb;
  398.         tb2            = QSetPort dPtr tb1;
  399.         tb3            = QEraseRect (l,t,inc (l + w),inc (t + h)) tb2;
  400.         tb4            = QDrawPopUp (l,t,w,h) able item tb3;
  401.         tb5            = QSetPort port tb4;
  402.         able        = Enabled select;
  403.     };
  404.  
  405. QDrawPopUp :: !Rect !Bool !String !Toolbox -> Toolbox;
  406. QDrawPopUp (l,t,w,h) able item tb
  407.     =    tb7;
  408.     where {
  409.         tb1    = QDrawArrow able r t tb;
  410.         tb2    = QMoveTo (l + 4) base tb1;
  411.         tb3    = QDrawString item tb2;
  412.         tb4    = QFrameRect (l,t,r1,b1) tb3;
  413.         tb5    = QMoveTo r1 (t + 2) tb4;
  414.         tb6    = QLineTo r1 b1 tb5;
  415.         tb7    = QLineTo (l + 2) b1 tb6;
  416.         r1    = inc r;
  417.         b1    = inc b;
  418.         r    = l + w;
  419.         b    = t + h;
  420.         base= t + BaseOfs;
  421.     };
  422.  
  423. RedrawPopUpItemText :: !ItemPos !String !DialogPtr !Toolbox -> Toolbox;
  424. RedrawPopUpItemText (ItemBox l t w h) item dPtr tb
  425.     =    tb8;
  426.     where {
  427.         (port, tb1)    = QGetPort tb;
  428.         tb2            = QSetPort dPtr tb1;
  429.         tb3            = QEraseRect (inc l,inc t,r - 17,b) tb2;
  430.         tb4            = QMoveTo (l + 4) (t + BaseOfs) tb3;
  431.         tb5            = QTextMode SrcOr tb4;
  432.         tb6            = QDrawString item tb5;
  433.         tb7            = QTextMode SrcCopy tb6;
  434.         tb8            = QSetPort port tb7;
  435.         r            = l + w;
  436.         b            = t + h;
  437.     };
  438.  
  439. DrawPopUpAbility :: !ItemPos !SelectState !DialogPtr !Toolbox -> Toolbox;
  440. DrawPopUpAbility (ItemBox l t w h) select dPtr tb
  441.     =    tb4;
  442.     where {
  443.         (port, tb1)    = QGetPort tb;
  444.         tb2            = QSetPort dPtr tb1;
  445.         tb3            = QDrawArrow (Enabled select) (l + w) t tb2;
  446.         tb4            = QSetPort port tb3;
  447.     };
  448.     
  449. QDrawArrow :: !Bool !Int !Int !Toolbox -> Toolbox;
  450. QDrawArrow able x y tb
  451. |    able    = enarrow;
  452.             = QPenPat Black disarrow;
  453.     where {
  454.         enarrow        = MakeMacPicture (FillPolygon arrow (MakePicture tb));
  455.         disarrow    = MakeMacPicture (FillPolygon arrow dpict);
  456.         dpict        = MakePicture (QPenPat Gray tb);
  457.         arrow        = ((x - 16,y + 6), [(12,0), (-6,6)]);
  458.     };
  459.  
  460. DrawIconOrControl :: !ItemPos !Rectangle ![DrawFunction] !DialogPtr !Toolbox -> Toolbox;
  461. DrawIconOrControl (ItemBox bl bt w h) ((rl,rt),(r,b)) look dPtr tb
  462.     =    tb11;
  463.     where {
  464.         (port,tb1)    = QGetPort tb;
  465.         tb2            = QSetPort dPtr tb1;
  466.         (rgn, tb3)    = QNewRgn tb2;
  467.         (rgn1,tb4)    = QGetClip rgn tb3;
  468.         tb5            = QSetOrigin (rl - bl) (rt - bt) tb4;
  469.         tb6            = QClipRect (rl,rt,r,b) tb5;
  470.         tb7            = DrawTheLook look tb6;
  471.         tb8            = QSetOrigin 0 0 tb7;
  472.         tb9            = QSetClip rgn1 tb8;
  473.         tb10        = QSetPort port tb9;
  474.         tb11        = QDisposeRgn rgn1 tb10;
  475.     };
  476.  
  477. RedrawIconOrControl :: !ItemPos !Rectangle ![DrawFunction] !DialogPtr !Toolbox -> Toolbox;
  478. RedrawIconOrControl (ItemBox bl bt w h) ((rl,rt),(r,b)) look dPtr tb
  479.     =    tb12;
  480.     where {
  481.         (port, tb1)    = QGetPort tb;
  482.         tb2            = QSetPort dPtr tb1;
  483.         (rgn,  tb3)    = QNewRgn tb2;
  484.         (rgn1, tb4)    = QGetClip rgn tb3;
  485.         tb5            = QSetOrigin (rl - bl) (rt - bt) tb4;
  486.         tb6            = QClipRect rect tb5;
  487.         tb7            = QEraseRect rect tb6;
  488.         tb8            = DrawTheLook look tb7;
  489.         tb9            = QSetOrigin 0 0 tb8;
  490.         tb10        = QSetClip rgn1 tb9;
  491.         tb11        = QSetPort port tb10;
  492.         tb12        = QDisposeRgn rgn1 tb11;
  493.         rect        = (rl,rt,r,b);
  494.     };
  495.  
  496. DrawTheLook :: ![DrawFunction] !Toolbox -> Toolbox;
  497. DrawTheLook look tb
  498.     =    tb4;
  499.     where {
  500.         tb1 = MakeMacPicture (ApplyDrawFunctions look (MakePicture tb));
  501.         tb2 = QTextFont 0 tb1;
  502.         tb3 = QTextFace 0 tb2;
  503.         tb4 = QTextSize 0 tb3;
  504.     };
  505.  
  506. ApplyDrawFunctions :: ![DrawFunction] !Picture -> Picture;
  507. ApplyDrawFunctions [drawF : drawFs] picture = ApplyDrawFunctions drawFs (drawF picture);
  508. ApplyDrawFunctions drawFs picture
  509.     =    picture3;
  510.     where {
  511.         picture1 = SetBackColour WhiteColour picture;
  512.         picture2 = SetPenColour  BlackColour picture1;
  513.         picture3 = SetPenNormal  picture2;
  514.     };
  515.  
  516.  
  517. //    Create the items of a dialog.
  518.  
  519. CreateDialogItems :: ![DialogItem s (IOState s)] !Toolbox -> (!Handle,!Toolbox);
  520. CreateDialogItems items tb
  521.     =    (h1, tb4);
  522.     where {
  523.         (h1, ptr1)    = s1;
  524.         (s1, tb4)    = FillDialogItems items s tb3;
  525.         (s,     tb3)    = Append_word (h,ptr) c tb2;
  526.         (ptr,tb2)    = DereferenceHandle h tb1;
  527.         (h,     tb1)    = AllocateHandle size tb;
  528.         (c,  size)    = DialogItemsSize items;
  529.     };
  530.  
  531. CreateNoticeItems :: ![DialogItem s (IOState s)] !Toolbox -> (!Handle, !ProcPtr, !Toolbox);
  532. CreateNoticeItems items tb
  533.     =    (h1, outlineF, tb5);
  534.     where {
  535.         (h1, ptr1)    = s2;
  536.         (s2, tb5)    = AppendUserItem rect outlineF (s1, tb4);
  537.         outlineF    = OutlineButtonFunction;
  538.         (s1, tb4)    = FillDialogItems items s tb3;
  539.         (s,     tb3)    = Append_word (h,ptr) c tb2;
  540.         (ptr,tb2)    = DereferenceHandle h tb1;
  541.         (h,     tb1)    = AllocateHandle size tb;
  542.         (c, size)    = NoticeItemsSize items;
  543.         rect        = GetDefaultButtonRect items;
  544.     };
  545.  
  546. GetDefaultButtonRect :: ![DialogItem s (IOState s)] -> Rect;
  547. GetDefaultButtonRect [DialogButton _ (ItemBox l t w h) _ _ _ : _] = (l,t, l+w,t+h);
  548. GetDefaultButtonRect _
  549.     =    DialogInternalError "GetDefaultButtonRect" "No default button found in notice";
  550.  
  551.  
  552. /*    Calculate the heap-size occupied by the dialog items. In a notice extra room must be
  553.     reserved for the outline of the default button (a user item). */
  554.  
  555. DialogItemsSize    :: ![DialogItem s (IOState s)] -> (!Int,!Int);
  556. DialogItemsSize items = CalcItemsSize items (-1,2);
  557.  
  558. NoticeItemsSize    :: ![DialogItem s (IOState s)] -> (!Int,!Int);
  559. NoticeItemsSize items = CalcItemsSize items (0,16);
  560.  
  561. CalcItemsSize :: ![DialogItem s (IOState s)] (!Int,!Int) -> (!Int,!Int);
  562. CalcItemsSize items cs
  563.     =    cs`;
  564.     where {
  565.         (items`, cs`) = StateMap CalcItemSize items cs;
  566.     };
  567.  
  568. CalcItemSize :: !(DialogItem s (IOState s)) !(!Int,!Int) -> (DialogItem s (IOState s), !(!Int,!Int));
  569. CalcItemSize item=:(DialogButton i l title a f) (c,s)
  570.     =    (item, (inc c, Align (size title  + (s + 14))));
  571. CalcItemSize item=:(StaticText i l text) (c,s)
  572.     =    (item, (inc c, Align (size text  + (s + 14))));
  573. CalcItemSize item=:(DynamicText i l w text) (c,s)
  574.     =    (item, (inc c, Align (size text  + (s + 14))));
  575. CalcItemSize item=:(EditText i l w n text) (c,s)
  576.     =    (item, (inc c, Align (size text  + (s + 14))));
  577. CalcItemSize item=:(CheckBoxes i l r boxes) (c,s)
  578.     =    (item, (c + nrb, s + size));
  579.     where {
  580.         (nrb,size) = CalcCheckBoxesSize boxes (0,0);
  581.     };
  582. CalcItemSize item=:(RadioButtons i l r d buttons) (c,s)
  583.     =    (item, (c + nrb, s + size));
  584.     where {
  585.         (nrb,size) = CalcRadioButtonsSize buttons (0,0);
  586.     };
  587. CalcItemSize item cs = (item, cs);
  588.  
  589. CalcCheckBoxesSize    :: ![CheckBoxDef s (IOState s)] (!Int,!Int) -> (!Int,!Int);
  590. CalcCheckBoxesSize [CheckBox i ttl a m f : boxes] (c,s)
  591.     =     CalcCheckBoxesSize boxes (inc c,  Align (size ttl)  + (s + 14));
  592. CalcCheckBoxesSize [] s =  s;
  593.  
  594. CalcRadioButtonsSize    :: ![RadioItemDef s (IOState s)] (!Int,!Int) -> (!Int,!Int);
  595. CalcRadioButtonsSize [RadioItem i ttl a f : buttons] (c,s)
  596.     =     CalcRadioButtonsSize buttons (inc c,  Align (size ttl)  + (s + 14));
  597. CalcRadioButtonsSize [] s =  s;
  598.  
  599.  
  600. //    Place the items in the item list in the dialog.
  601.  
  602. FillDialogItems :: ![DialogItem s (IOState s)] !Structure !Toolbox -> (!Structure,!Toolbox);
  603. FillDialogItems items struct tb
  604.     =    s;
  605.     where {
  606.         (items1, s) = StateMap FillDlogItem items (struct, tb);
  607.     };
  608.  
  609. FillDlogItem :: !(DialogItem s (IOState s)) !(!Structure, !Toolbox)
  610.     ->    (DialogItem s (IOState s), !(!Structure, !Toolbox));
  611. FillDlogItem item=:(DialogButton i (ItemBox l t w h) title a f) s
  612.     =    (item, AppendButton (l,t,l + w,t + h) title s);
  613. FillDlogItem item=:(StaticText i (ItemBox l t w h) text) s
  614.     =    (item, AppendStaticText (l,t,l + w,t + h) text s);
  615. FillDlogItem item=:(DynamicText i (ItemBox l t w h) m text) s
  616.     =    (item, AppendStaticText (l,t,l + w,t + h) text s);
  617. FillDlogItem item=:(EditText i (ItemBox l t w h) m n text) s
  618.     =    (item, AppendEditText (l,t,l + w,t + h) text s);
  619. FillDlogItem item=:(CheckBoxes i (ItemBox l t w h) (Rows nr) boxes) s
  620.     =    (item, FillRowCheckBoxes 1 nr l t t w h boxes s);
  621. FillDlogItem item=:(CheckBoxes i (ItemBox l t w h) (Columns nr) boxes) s
  622.     =    (item, FillColumnCheckBoxes 1 nr l l t w h boxes s);
  623. FillDlogItem item=:(RadioButtons i (ItemBox l t w h) (Rows nr) d buttons) s
  624.     =    (item, FillRowRadioButtons 1 nr l t t w h buttons s);
  625. FillDlogItem item=:(RadioButtons i (ItemBox l t w h) (Columns nr) d buttons) s
  626.     =    (item, FillColumnRadioButtons 1 nr l l t w h buttons s);
  627. FillDlogItem item s = (item, s);
  628.  
  629. FillRowCheckBoxes :: !Int !Int !Int !Int !Int !Int !Int
  630.                      ![CheckBoxDef s (IOState s)] !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  631. FillRowCheckBoxes i nr l t tt w h boxes=:[CheckBox id title a m f : rest] s
  632. |    i > nr    = FillRowCheckBoxes 1       nr (l + w) tt tt w h boxes s;
  633.             = FillRowCheckBoxes (inc i) nr l        b tt w h rest (AppendCheckBox (l,t, l+w,b) title s);
  634.     where {
  635.         b = t+h;
  636.     };
  637. FillRowCheckBoxes _ _ _ _ _ _ _ _ s = s;
  638.  
  639. FillColumnCheckBoxes :: !Int !Int !Int !Int !Int !Int !Int
  640.         ![CheckBoxDef s (IOState s)] !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  641. FillColumnCheckBoxes i nr l ll t w h boxes=:[CheckBox id title a m f : rest] s
  642. |    i > nr     = FillColumnCheckBoxes 1       nr ll ll (t+h) w h boxes s;
  643.             = FillColumnCheckBoxes (inc i) nr r  ll t     w h rest (AppendCheckBox (l,t,r,t+h) title s);
  644.     where {
  645.         r = l+w;
  646.     };
  647. FillColumnCheckBoxes _ _ _ _ _ _ _ _ s = s;
  648.  
  649. FillRowRadioButtons    :: !Int !Int !Int !Int !Int !Int !Int
  650.         ![RadioItemDef s (IOState s)] !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  651. FillRowRadioButtons i nr l t tt w h radios=:[RadioItem id title a f : rest] s
  652. | i > nr    = FillRowRadioButtons 1          nr (l+w) tt tt w h radios s;
  653.             = FillRowRadioButtons (inc i) nr l        b tt w h rest (AppendRadioButton (l,t, l+w,b) title s);
  654.     where {
  655.         b = t+h;
  656.     };
  657. FillRowRadioButtons _ _ _ _ _ _ _ _ s = s;
  658.  
  659. FillColumnRadioButtons :: !Int !Int !Int !Int !Int !Int !Int
  660.         ![RadioItemDef s (IOState s)] !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  661. FillColumnRadioButtons i nr l ll t w h radios=:[RadioItem id title a f : rest] s
  662. | i > nr    = FillColumnRadioButtons 1         nr ll ll (t+h) w h radios s;
  663.             = FillColumnRadioButtons (inc i) nr r  ll t        w h rest (AppendRadioButton (l,t,r,t+h) title s);
  664.     where {
  665.         r = l+w;
  666.     };
  667. FillColumnRadioButtons _ _ _ _ _ _ _ _ s = s;
  668.  
  669. AppendButton :: !Rect !String !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  670. AppendButton rect name (struct, tb)
  671.     =    Append_string_and_align struct2 name tb2;
  672.     where {
  673.         (struct1, tb1) = Append_zero_and_rect struct rect tb;
  674.         (struct2, tb2) = Append_byte struct1 4 tb1;
  675.     };
  676.  
  677. AppendStaticText :: !Rect !String !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  678. AppendStaticText rect name (struct, tb)
  679.     =    Append_string_and_align struct2 name tb2;
  680.     where {
  681.         (struct1, tb1) = Append_zero_and_rect struct rect tb;
  682.         (struct2, tb2) = Append_byte struct1 136 tb1;
  683.     };
  684.  
  685. AppendEditText :: !Rect !String !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  686. AppendEditText rect name (struct, tb)
  687.     =    Append_string_and_align struct2 name tb2;
  688.     where {
  689.         (struct1, tb1) = Append_zero_and_rect struct rect tb;
  690.         (struct2, tb2) = Append_byte struct1 144 tb1;
  691.     };
  692.  
  693. AppendCheckBox :: !Rect !String !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  694. AppendCheckBox rect name (struct, tb)
  695.     =    Append_string_and_align struct2 name tb2;
  696.     where {
  697.         (struct1, tb1) = Append_zero_and_rect struct rect tb;
  698.         (struct2, tb2) = Append_byte struct1 5 tb1;
  699.     };
  700.  
  701. AppendRadioButton :: !Rect !String !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  702. AppendRadioButton rect name (struct, tb)
  703.     =    Append_string_and_align struct2 name tb2;
  704.     where {
  705.         (struct1, tb1) = Append_zero_and_rect struct rect tb;
  706.         (struct2, tb2) = Append_byte struct1 6 tb1;
  707.     };
  708.  
  709. AppendUserItem :: !Rect !ProcPtr !(!Structure, !Toolbox) -> (!Structure, !Toolbox);
  710. AppendUserItem (l,t,r,b) procPtr (struct, tb)
  711.     =    (struct7, tb7);
  712.     where {
  713.         (struct1, tb1) = Append_long struct procPtr    tb;
  714.         (struct2, tb2) = Append_word struct1 t        tb1;
  715.         (struct3, tb3) = Append_word struct2 l        tb2;
  716.         (struct4, tb4) = Append_word struct3 b        tb3;
  717.         (struct5, tb5) = Append_word struct4 r        tb4;
  718.         (struct6, tb6) = Append_byte struct5 128    tb5;
  719.         (struct7, tb7) = Append_byte struct6 0        tb6;
  720.     };
  721.  
  722.  
  723. /*    Miscellaneous functions. */
  724.  
  725. AllocateHandle    :: !Int !Toolbox -> (!Handle, !Toolbox);
  726. AllocateHandle size tb
  727. |    r <> 0    = DialogInternalError "AllocateHandle" "Out of memory";
  728.             = (h, tb1);
  729.     where {
  730.         (h,r,tb1) = NewHandle size tb;
  731.     };
  732.  
  733. Align :: !Int -> Int;
  734. Align n = inc n bitand (-2);
  735.